﻿(*
Daniel Anderegg 2013



*)
open System
open System.Collections.Generic 
open System.Windows.Input
open System.Media
open System.Windows
open System.Windows.Markup
open System.Xml
open System.Xaml
open System.IO
open System.Windows.Media
open System.Linq
open System.Linq.Expressions
open System.Xml
open System.Windows.Media.Imaging
open System.Windows.Controls
open Microsoft.FSharp.Control
open Microsoft.FSharp.Collections
open UItypes


type Canvas =
    val mutable width :int
    val mutable height :int
    val mutable render :byte array
    new(w,h) = { width = w; height = h; render = Array.create (h*w*4) (byte 255)}

type Brush =
    val mutable color :Color
    new() = { color = Color.FromRgb((byte 0),(byte 0),(byte 0)) }
    new(r,g,b) = { color = Color.FromRgb(r,g,b) }

type Tool =
    | PanZoom of Point*bool
    | ColorPicker of Point*Color
    | Ink of Brush

let paintpanel = new PaintPanel()
let viewpanel = new ViewPanel()

             
type inkcommand =
    | INK of Brush * Point list
    | RENDER of bool
    | CREATE of int * int

let RenderInk (can :Canvas) (brush :Brush) (pts :Point list) =
    for point in pts do
        let x = (int (Math.Round(point.X)))
        let y = (int (Math.Round(point.Y)))
        if ((x) < can.width) && ((y) < can.height) && ((x) > 0) && ((y) > 0) then
            can.render.[can.width*4*(y) + (x)*4] <- brush.color.B
            can.render.[can.width*4*(y) + (x)*4 + 1] <- brush.color.G
            can.render.[can.width*4*(y) + (x)*4 + 2] <- brush.color.R
    can.render |> ignore
    can

let FinalRender (can :Canvas) = 
    paintpanel.Dispatcher.BeginInvoke(Action(fun () -> (paintpanel.Source :?> WriteableBitmap).WritePixels(new Int32Rect(0, 0, can.width, can.height), can.render, can.width*4, 0))) |> ignore 
    paintpanel.Dispatcher.BeginInvoke(Action(fun () -> paintpanel.Width <- (float can.width))) |> ignore
    paintpanel.Dispatcher.BeginInvoke(Action(fun () -> paintpanel.Height <- (float can.height))) |> ignore

let Create (w,h) = 
    paintpanel.Dispatcher.BeginInvoke(Action(fun () -> paintpanel.Source <- WriteableBitmap(w,h,96.0,96.0,PixelFormats.Bgr32, null))) |> ignore

let INKProcesser = MailboxProcessor.Start(fun mbox ->
    let inkloop() = async {
        let pipeline :inkcommand list ref = ref ([])
        let canvas :Canvas ref = ref (Canvas(640,480))
        while true do
            let! msg = mbox.Receive()
            match msg with
            | INK (br,pts) -> pipeline := INK(br,pts) :: !pipeline; canvas := RenderInk !canvas br pts; FinalRender !canvas |> ignore
            | RENDER t -> FinalRender !canvas |> ignore
            | CREATE (w,h) -> canvas := new Canvas(w,h); Create(w,h) |> ignore; FinalRender !canvas |> ignore                         
    } inkloop() )

type UImessage = 
    | MouseMove of Point list
    | MouseDown of Point
    | MouseDownViewer of Point
    | MouseMoveViewer of Point
    | Zoom of Point * Point * int
    | MouseUp of Point
    | ChangeTool of Tool



let UIProcesser = MailboxProcessor.Start(fun mbox ->
    let inputloop() = async {
        let pointsbuff = ref ([])
        let tool = ref (Ink (new Brush((byte 255),(byte 0),(byte 0))))
        while true do
            let! msg = mbox.Receive()
            match msg with
            | MouseDown(p) -> match !tool with
                              | Ink br -> pointsbuff := [p]
                              | _ -> ()
            | MouseMove(pts) -> match !tool with
                              | Ink br -> pointsbuff := !pointsbuff @ pts
                              | _ -> ()  
            | MouseMoveViewer(pt) -> match !tool with
                                    | PanZoom (p,on) -> if on then viewpanel.Dispatcher.BeginInvoke(Action(fun () -> viewpanel.Pan(pt) )) |> ignore
                                    | _ -> ()
            | MouseDownViewer(pt) -> match !tool with
                                    | PanZoom (p,on) -> tool := PanZoom(p,true); viewpanel.Dispatcher.BeginInvoke(Action(fun () ->  viewpanel.StartPan(pt) ))  |> ignore
                                    | _ -> ()
            | MouseUp(p) ->  match !tool with
                              | Ink br -> INKProcesser.Post(INK(br,!pointsbuff))
                              | PanZoom (p,on) -> tool := PanZoom(p,false); viewpanel.Dispatcher.BeginInvoke(Action(fun () -> viewpanel.EndPan() )) |> ignore
                              | _ -> ()
            | Zoom(zp,cp,d) -> match !tool with 
                                 | PanZoom (p,on) -> viewpanel.Dispatcher.BeginInvoke(Action(fun () ->  viewpanel.Zoom zp d cp )) |> ignore
                                 | _ -> ()
            | ChangeTool(t) -> tool := t; Console.WriteLine(tool.ToString())
    } inputloop() )


let MouseMove (sender :IInputElement) (args : RoutedEventArgs) =
    match sender with
    | :? PaintPanel as pp -> 
        let mutable (points :Point array) = Array.zeroCreate 64
        let myPoint = Mouse.GetPosition(sender)
        let numpts = System.Windows.Input.Mouse.GetIntermediatePoints(sender,points)
        let plist :Point list = points |> Seq.truncate numpts |> Seq.toList
        UIProcesser.Post(MouseMove(myPoint :: plist))
    | :? ViewPanel as vp ->
        let myPoint = Mouse.GetPosition(sender)
        UIProcesser.Post(MouseMoveViewer(myPoint))
    | _ -> ()
    

let MouseDown (sender :IInputElement) (args : RoutedEventArgs) =
    match sender with
        | :? PaintPanel as pp ->
            let myPoint = Mouse.GetPosition(sender)
            UIProcesser.Post(MouseDown(myPoint))
        | :? ViewPanel as vp ->
            let myPoint = Mouse.GetPosition(sender)
            UIProcesser.Post(MouseDownViewer(myPoint))
        | _ -> ()

   

let MouseUp (sender ) (args: RoutedEventArgs) =
    let myPoint = Mouse.GetPosition(sender)
    sender.ReleaseMouseCapture |> ignore
    UIProcesser.Post(MouseUp(myPoint))

let MouseWheelViewer (args: MouseWheelEventArgs) =
    args.Handled <- true
    let myPoint = Mouse.GetPosition(viewpanel)
    let childPoint = Mouse.GetPosition(paintpanel)
    UIProcesser.Post(Zoom(myPoint,childPoint,args.Delta))
    

 

let main() =
    let window = Application.LoadComponent(new System.Uri("/window.xaml", System.UriKind.Relative)) :?> Window
    let toolzp = window.FindName("ToolZoomPan") :?> MenuItem
    let toolink = window.FindName("ToolInk") :?> MenuItem
    let rowgrid = window.FindName("RowGrid") :?> Grid
    
    Grid.SetRow(viewpanel,2) |> ignore
    rowgrid.Children.Add(viewpanel) |> ignore
    viewpanel.Content <- paintpanel
    INKProcesser.Post(CREATE(640,480))

    viewpanel.ScrollChanged.Add(fun args -> viewpanel.OnScrollViewerScrollChanged viewpanel args)
    viewpanel.PreviewMouseLeftButtonDown.Add(fun args -> MouseDown viewpanel args)
    viewpanel.PreviewMouseMove.Add(fun args -> MouseMove viewpanel args)
    viewpanel.PreviewMouseWheel.Add(MouseWheelViewer)
    toolink.Click.Add(fun args -> UIProcesser.Post(ChangeTool(Ink(Brush()))))
    toolzp.Click.Add(fun args -> UIProcesser.Post(ChangeTool(PanZoom(Point(0.0,0.0),false))))
    paintpanel.MouseLeftButtonDown.Add(fun args -> MouseDown paintpanel args)
    window.MouseLeftButtonUp.Add(fun args -> MouseUp paintpanel args)
    paintpanel.MouseMove.Add(fun args -> MouseMove paintpanel args)

    
    (new Application()).Run(window) |> ignore


[<STAThread>]
do main()